home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / dev / lang / fpc09905c.lha / fpc / inc / objinc.inc < prev    next >
Text File  |  1998-09-21  |  10KB  |  306 lines
  1. {
  2.     $Id: objinc.inc,v 1.3 1998/07/13 12:31:40 carl Exp $
  3.     This file is part of the Free Pascal run time library.
  4.     Copyright (c) 1993-98 by the Free Pascal development team.
  5.  
  6.     Includefile for objects.pp implementing OS-dependent file routines
  7.     for AmigaOS
  8.  
  9.     See the file COPYING.FPC, included in this distribution,
  10.     for details about the copyright.
  11.  
  12.     This program is distributed in the hope that it will be useful,
  13.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  14.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  15.  
  16.  **********************************************************************
  17. }
  18.  
  19.     Const
  20.  
  21.     _LVOFindTask          = -294;
  22.     _LVOWaitPort          = -384;
  23.     _LVOGetMsg            = -372;
  24.     _LVOOpenLibrary       = -552;
  25.     _LVOCloseLibrary      = -414;
  26.     _LVOClose             = -36;
  27.     _LVOOpen              = -30;
  28.     _LVOIoErr             = -132;
  29.     _LVOSeek              = -66;
  30.     _LVODeleteFile        = -72;
  31.     _LVORename            = -78;
  32.     _LVOWrite             = -48;
  33.     _LVORead              = -42;
  34.     _LVOCreateDir         = -120;
  35.     _LVOSetCurrentDirName = -558;
  36.     _LVOGetCurrentDirName = -564;
  37.     _LVOInput             = -54;
  38.     _LVOOutput            = -60;
  39.     _LVOUnLock            = -90;
  40.     _LVOLock              = -84;
  41.     _LVOCurrentDir        = -126;
  42.  
  43.     _LVONameFromLock      = -402;
  44.     _LVONameFromFH        = -408;
  45.     _LVOGetProgramName    = -576;
  46.     _LVOGetProgramDir     = -600;
  47.     _LVODupLock           =  -96;
  48.     _LVOExamine           = -102;
  49.     _LVOParentDir         = -210;
  50.     _LVOSetFileSize       = -456;
  51.  
  52.  
  53.  
  54.  
  55. {---------------------------------------------------------------------------}
  56. {  FileClose -> Platforms AmigaOS          - Not checked                    }
  57. {---------------------------------------------------------------------------}
  58. FUNCTION FileClose(Handle: THandle): word;
  59. begin
  60.   asm
  61.             move.l  handle,d1
  62.             move.l  a6,d6              { save a6 }
  63.             move.l  _DOSBase,a6
  64.             jsr     _LVOClose(a6)
  65.             move.l  d6,a6              { restore a6 }
  66.   end;
  67.    FileClose := 0;
  68. end;
  69.  
  70. {---------------------------------------------------------------------------}
  71. {  FileOpen -> Platforms AmigaOS          - 08Jul98 CEC                     }
  72. {  Returns 0 on failure                                                     }
  73. {---------------------------------------------------------------------------}
  74.  
  75. FUNCTION FileOpen (Var FileName: AsciiZ; Mode: Word): THandle;
  76. var
  77.  oflags : longint;
  78.  AHandle : THandle;
  79. begin
  80.   AHandle:=0;
  81.   { On opening reset error code }
  82.   DosStreamError := 0;
  83.   if Mode=stCreate then
  84.       { read/write file with creation of file }
  85.       oflags := 1006
  86.   else
  87.       { read/write access on existing file }
  88.       oflags := 1005;
  89.       asm
  90.              move.l  a6,d6                  { save a6 }
  91.  
  92.              move.l  FileName,d1
  93.              move.l  oflags,d2               { MODE_READWRITE }
  94.              move.l  _DOSBase,a6
  95.              jsr     _LVOOpen(a6)
  96.              tst.l   d0
  97.              bne     @noopenerror           { on zero an error occured }
  98.              jsr     _LVOIoErr(a6)
  99.              move.w  d0,DosStreamError
  100.              bra     @openend
  101.           @noopenerror:
  102.              move.l  d6,a6                 { restore a6 }
  103.              move.l  d0,AHandle            { we need the base pointer to access this variable }
  104.              bra     @end
  105.           @openend:
  106.              move.l  d6,a6                 { restore a6 }
  107.           @end:
  108.          end;
  109.    FileOpen := AHandle;
  110. end;
  111.  
  112.  
  113. {***************************************************************************}
  114. {  DosSetFilePtr -> Platforms AmigaOS      - 08Jul98 CEC                    }
  115. {***************************************************************************}
  116. FUNCTION SetFilePos (Handle: THandle; Pos: LongInt; MoveType: Word;
  117. Var Actual: LongInt): Word;
  118. Var
  119.   Move_typ : longint;
  120. BEGIN
  121.   Move_typ := 0;
  122.   { Move from beginning of file }
  123.   if MoveType = 0 then
  124.    Move_typ := -1;
  125.   { Move from current position of file }
  126.   If MoveType = 1 then
  127.    Move_typ := 0;
  128.   { Move from end of file              }
  129.   If MoveType = 2 then
  130.     Move_typ := 1;
  131.        { We have to seek TWO times, if we wish to get the actual absolute }
  132.        { file position normally.                                          }
  133.        asm
  134.              move.l  a6,d6                { Save base pointer            }
  135.  
  136.              move.l  handle,d1
  137.              move.l  d2,-(sp)
  138.              move.l  d3,-(sp)              { save registers              }
  139.  
  140.              move.l  pos,d2
  141.              move.l  Move_typ,d3           { Setup correct move type     }
  142.              move.l  _DOSBase,a6
  143.              jsr    _LVOSeek(a6)
  144.  
  145.              move.l  (sp)+,d3              { restore registers }
  146.              move.l  (sp)+,d2
  147.              cmp.l   #-1,d0                { is there a file access error? }
  148.              bne     @noerr_one            { no, then seek a second time   }
  149.              jsr     _LVOIoErr(a6)         { yes ,get error in d0 and jmp  }
  150.              bra     @err
  151.       @noerr_one:                          { Seek a second time            }
  152.              move.l  d6,a6                 { Restore base pointer          }
  153.  
  154.              move.l  handle,d1
  155.              move.l  d2,-(sp)
  156.              move.l  d3,-(sp)              { save registers                }
  157.  
  158.              move.l  pos,d2
  159.              move.l  Move_typ,d3           { Setup correct move type     }
  160.              move.l  _DOSBase,a6
  161.              jsr    _LVOSeek(a6)
  162.  
  163.              move.l  (sp)+,d3              { restore registers }
  164.              move.l  (sp)+,d2
  165.              cmp.l   #-1,d0                { is there a file access error? }
  166.              bne     @noerr
  167.              jsr     _LVOIoErr(a6)
  168.       @err:
  169.              move.w  d0,DosStreamError
  170.              move.l  d6,a6                 { restore a6 }
  171.              bra     @seekend
  172.       @noerr:
  173.              move.l  d6,a6                 { restore a6 }
  174.              move.l  Actual,a0             { Get address of variable }
  175.              move.l  d0,(a0)               { Set value of Actual     }
  176.       @seekend:
  177.        end;
  178.    SetFilePos := DosStreamError;                   { Return any error }
  179. END;
  180.  
  181.  
  182. {---------------------------------------------------------------------------}
  183. {  FileRead -> Platforms AmigaOS          - 08Jul98 CEC                     }
  184. {---------------------------------------------------------------------------}
  185. FUNCTION FileRead (Handle: THandle; Var Buf; Count: Sw_Word;
  186. Var Actual: Sw_Word): Word;
  187. BEGIN
  188.   if Count <= 0 then
  189.   Begin
  190.      FileRead:=1;  { Return a non zero error }
  191.      exit;
  192.   end;
  193.   asm
  194.             move.l  a6,d6
  195.  
  196.             movem.l d2/d3,-(sp)
  197.             move.l  handle,d1         { we must set up aparamters BEFORE }
  198.             move.l  buf,d2            { setting up a6 for the OS call    }
  199.             move.l  count,d3
  200.             move.l  _DOSBase,a6
  201.             jsr     _LVORead(a6)
  202.             movem.l (sp)+,d2/d3
  203.  
  204.             cmp.l   #-1,d0
  205.             bne     @doswrend              { if -1 = error }
  206.             jsr     _LVOIoErr(a6)
  207.             move.w  d0,DosStreamError
  208.             bra     @doswrend2
  209.           @doswrend:
  210.             { to store a result for the function  }
  211.             { we must of course first get back the}
  212.             { base pointer!                       }
  213.             move.l  d6,a6
  214.             move.l  Actual,a0   { Actual is a pointer! }
  215.             move.l  d0,(a0)
  216.             bra     @end
  217.           @doswrend2:
  218.             move.l  d6,a6
  219.           @end:
  220.   end;
  221.   FileRead:=DosStreamError;
  222. end;
  223.  
  224.  
  225. {---------------------------------------------------------------------------}
  226. {  FileWrite -> Platforms AmigAOS          - 08Jul98 CEC                    }
  227. {---------------------------------------------------------------------------}
  228. FUNCTION FileWrite (Handle: THandle; Var Buf; Count: Sw_Word; Var Actual: Sw_Word): Word;
  229. BEGIN
  230.   if Count <= 0 then
  231.    Begin
  232.     FileWrite:=1;  { Return a non zero error code }
  233.     exit;
  234.    end;
  235.   asm
  236.             move.l  a6,d6
  237.  
  238.             movem.l d2/d3,-(sp)
  239.             move.l  handle,d1             { we must of co